home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 051-060 / amok58 / realconversions2 / realconversions2.mod < prev    next >
Text File  |  1993-11-04  |  6KB  |  257 lines
  1.  
  2. (**********************************************************************
  3.  
  4.   :Program.    (Long)RealConversions2
  5.   :Contents.   Procedures for converting strings to reals and vice versa
  6.   :Author.     Stefan Salewski
  7.   :Address.    Stefan Salewski, Stolper Weg 3, D-2160 Stade
  8.   :Copyright.  FD
  9.   :Language.   Oberon
  10.   :Translator. Amiga-Oberon-Compiler V2.0
  11.   :History.    V1.0     18-08-91
  12.   :Remark.     Replacement of the original REAL- and LONGREAL-Conversions
  13.   :Remark.     This module if more accurate
  14.   :Remark.     To get the version for LONGREALs, type in CLI:
  15.   :Remark.     Oberon SET LONGREAL RealConversion2
  16.  
  17. **********************************************************************)
  18.  
  19.  
  20. (* $IF LONGREAL *)
  21. MODULE LongRealConversions2;
  22.   IMPORT MathLib0:MathIEEEDoubBas;
  23.   TYPE   Real=LONGREAL;
  24.   CONST  ExpSize=5; (* Strings.Length('-E007') *)
  25.          TenE18 =1.0D18;
  26.  
  27. (* $ELSE *)
  28. MODULE RealConversions2;
  29.   IMPORT MathLib0:MathFFP;
  30.   TYPE   Real=REAL;
  31.   CONST  ExpSize=4; (* Strings.Length('-E07') *)
  32.          TenE18 =1.0E18;
  33.  
  34. (* $END *)
  35.  
  36.   CONST
  37.     Digit='0123456789';
  38.     MaxReal=MAX(Real);
  39.     MinReal=MIN(Real);
  40.     Plus= '+';
  41.     Minus='-';
  42.     Space=' ';
  43.     Point='.';
  44.     Exponent='E';
  45.     Nul=0X;
  46.     TenE6     =1000000;
  47.     TenE8     =100000000;
  48.  
  49.   PROCEDURE Pow10(n:INTEGER):Real;
  50.   (* Only for n>=0; RETURNS 10^n *)
  51.     VAR
  52.       x:Real;
  53.   BEGIN
  54.     IF n<0 THEN HALT(0) END;
  55.     x:=1;
  56.     WHILE n>0 DO
  57.       IF n>=18 THEN
  58.         x:=x*TenE18;
  59.         DEC(n,18)
  60.       ELSIF n>=6 THEN
  61.         x:=x*TenE6;
  62.         DEC(n,6)
  63.       ELSE
  64.         x:=x*10;
  65.         DEC(n)
  66.       END;
  67.     END;
  68.     RETURN x
  69.   END Pow10;
  70.  
  71.   PROCEDURE Norm(VAR x:Real; VAR n:INTEGER);
  72.   (* Only for x>=0 ;  RETURNS 1 <= x <10 (or zero if x=0 ) *)
  73.   BEGIN
  74.     n:=0;
  75.     IF x=0 THEN RETURN END;
  76.     WHILE x< (1/TenE18) DO x:=x*TenE18; DEC(n,18) END;
  77.     WHILE x>=   TenE18  DO x:=x/TenE18; INC(n,18) END;
  78.     WHILE x< (1/TenE6)  DO x:=x*TenE6;  DEC(n,6)  END;
  79.     WHILE x>=   TenE6   DO x:=x/TenE6;  INC(n,6)  END;
  80.     WHILE x< 1          DO x:=x*10;     DEC(n)    END;
  81.     WHILE x>=10         DO x:=x/10;     INC(n)    END;
  82.     IF x<1 THEN x:=1 END;
  83.   END Norm;
  84.  
  85.   PROCEDURE DeleteSpaces*(VAR str:ARRAY OF CHAR);
  86.     VAR
  87.       s,d:INTEGER;
  88.   BEGIN
  89.     s:=0; d:=0;
  90.     WHILE (s<LEN(str)) AND (str[s]#0X) DO
  91.       IF str[s]#Space THEN
  92.         str[d]:=str[s];
  93.         INC(d)
  94.       END;
  95.       INC(s);
  96.     END;
  97.     IF d<LEN(str) THEN str[d]:=0X END;
  98.   END DeleteSpaces;
  99.  
  100.   PROCEDURE RealToString*(x:Real;
  101.                           VAR str:ARRAY OF CHAR;
  102.                           gs,nks:INTEGER;expo,left:BOOLEAN):BOOLEAN;
  103.     VAR
  104.       pos,oldgs,vks,e,len:INTEGER;
  105.       oldx:Real;
  106.       xneg:BOOLEAN;
  107.  
  108.     PROCEDURE Put(c:CHAR);
  109.     BEGIN
  110.       IF pos<LEN(str) THEN str[pos]:=c; INC(pos) END
  111.     END Put;
  112.  
  113.     PROCEDURE Format;
  114.     BEGIN
  115.       IF e>=gs THEN expo:=TRUE END;
  116.       IF expo OR (e<0) THEN
  117.         vks:=1;
  118.       ELSE
  119.         vks:=e+1
  120.       END;
  121.       IF (gs>vks+nks) THEN gs:=vks+nks END;
  122.       IF NOT expo AND (e<0) THEN x:=oldx END;
  123.     END Format;
  124.  
  125.   BEGIN
  126.     xneg:=x<0;
  127.     x:=ABS(x);
  128.     oldx:=x;
  129.     oldgs:=gs;
  130.     Norm(x,e);
  131.     Format;
  132.     x:=x+5/Pow10(gs);
  133.     IF x>=10 THEN
  134.       x:=x/10;
  135.       IF x<1 THEN x:=1 END;
  136.       INC(e);
  137.       gs:=oldgs;
  138.       Format;
  139.     END;
  140.     len:=gs+1;
  141.     IF expo THEN INC(len,ExpSize) END;
  142.     IF nks>0 THEN INC(len)  END;
  143.     IF len>LEN(str) THEN RETURN FALSE END;
  144.     pos:=0;
  145.     IF NOT left THEN
  146.       WHILE pos<(LEN(str)-len) DO Put(Space) END;
  147.     END;
  148.     IF xneg THEN Put(Minus) ELSE Put(Space) END;
  149.     WHILE gs>0 DO
  150.       IF vks=0 THEN Put(Point) END;
  151.       DEC(vks);
  152.       DEC(gs);
  153.       Put(Digit[ENTIER(x) MOD 10]);
  154.       IF x>TenE8 THEN x:=x-MathLib0.Floor(x) END;
  155.       x:=x*10;
  156.     END;
  157.     IF expo THEN
  158.       Put(Exponent);
  159.       IF e<0 THEN
  160.         Put(Minus);
  161.         e:=-e;
  162.       ELSE
  163.         Put(Plus)
  164.       END;
  165.       (* $IF LONGREAL *)
  166.       Put(Digit[e DIV 100]);
  167.       e:=e MOD 100;
  168.       (* $END *)
  169.       Put(Digit[e DIV 10]);
  170.       Put(Digit[e MOD 10]);
  171.     END;
  172.     Put(Nul);
  173.     RETURN TRUE;
  174.   END RealToString;
  175.  
  176.   PROCEDURE StringToReal*(str:ARRAY OF CHAR;VAR x:Real):BOOLEAN;
  177.  
  178.     VAR
  179.       pos,e:INTEGER;
  180.       neg,expoNeg:BOOLEAN;
  181.       pow:Real;
  182.       c:CHAR;
  183.  
  184.     PROCEDURE Next;
  185.     BEGIN
  186.       INC(pos);
  187.       IF pos<LEN(str) THEN c:=str[pos] ELSE c:=0X END;
  188.     END Next;
  189.  
  190.     PROCEDURE Negative():BOOLEAN;
  191.     BEGIN
  192.       CASE c OF '-':Next; RETURN TRUE|
  193.                 '+':Next
  194.       ELSE END;
  195.       RETURN FALSE
  196.     END Negative;
  197.  
  198.     PROCEDURE ReadReal;
  199.       VAR
  200.         pow:Real;
  201.         neg:BOOLEAN;
  202.         start,pointPos,p:INTEGER;
  203.     BEGIN
  204.       x:=0;
  205.       neg:=Negative();
  206.       start:=pos;
  207.       pow:=1;
  208.       pointPos:=MAX(INTEGER);
  209.       WHILE (c>='0') AND (c<='9') DO Next END;
  210.       IF c=Point THEN pointPos:=pos; Next END;
  211.       WHILE (c>='0') AND (c<='9') DO Next END;
  212.       p:=pos-1;
  213.       WHILE p>pointPos DO
  214.         x:=(x+(ORD(str[p])-ORD('0')))/10;
  215.         DEC(p)
  216.       END;
  217.       IF (p>=0) AND (str[p]=Point) THEN DEC(p) END;
  218.       WHILE p>=start DO
  219.         x:=x+pow*(ORD(str[p])-ORD('0'));
  220.         pow:=pow*10;
  221.         DEC(p);
  222.       END;
  223.       IF neg THEN x:=-x END;
  224.     END ReadReal;
  225.  
  226.   BEGIN
  227.     pos:=-1;
  228.     Next;
  229.     ReadReal;
  230.     IF (x=MaxReal) OR (x=MinReal) THEN RETURN FALSE END;
  231.     IF (c='e') OR (c='E') THEN
  232.       e:=0;
  233.       Next;
  234.       expoNeg:=Negative();
  235.       WHILE (e<=1000) AND (c>='0') AND (c<='9') DO
  236.         e:=e*10+(ORD(c)-ORD('0'));
  237.         Next;
  238.       END;
  239.       pow:=Pow10(e);
  240.       IF (pow=MaxReal) OR (pow=MinReal) THEN RETURN FALSE END;
  241.       IF expoNeg THEN
  242.         x:=x/pow
  243.       ELSE
  244.         x:=x*pow
  245.       END
  246.     END;
  247.     RETURN (c=0X) AND (x#MaxReal) AND (x#MinReal)
  248.   END StringToReal;
  249.  
  250. (* $IF LONGREAL *)
  251. END LongRealConversions2.
  252. (* $ELSE *)
  253. END RealConversions2.
  254. (* $END *)
  255.  
  256.  
  257.